home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.002 / GOLDCAL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  23KB  |  779 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {*********************************}
  12.                     {**       Unit:   GOLDCAL       **}
  13.                     {*********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDCAL; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDCAL}
  19.    {$DEFINE GOLDCAL}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. {Development notes
  25.        1.01a    07/10/95    permitted compilation with TP6
  26. }
  27.  
  28. uses DOS, CRT, GoldHard, GoldTint, GoldWin, GoldMisc, GoldKey,
  29.      GoldFast, GoldDate, GoldStr;
  30.  
  31.  
  32. type
  33.    gCalChange = (Paint,ChangeDay,ChangeMonth);
  34.    CalChangeProc = procedure(CType:gCalChange;Val1,Val2:dates);
  35.    CalColorProc = procedure(DaytoColor:Dates; var DefCol: byte);
  36.  
  37.    CalInfo = record   {attached to the Window UserData pointer}
  38.       ActiveDay:word;
  39.       ActiveMonth:word;
  40.       ActiveYear:longint;
  41.       ActiveDate,
  42.       Today,
  43.       FofM,
  44.       LofM,
  45.       AnchorDay: Dates;
  46.    end; { CalInfo }
  47.  
  48.    CALSet = record
  49.       LastECode: integer;
  50.       NextMkey: word;     {keys pressed to change months/years}
  51.       PrevMkey: word;
  52.       NextYkey: word;
  53.       PrevYkey: word;
  54.       NextMchar: char;    {characters displayed as icons for changing M/Y}
  55.       PrevMchar: char;
  56.       NextYchar: char;
  57.       PrevYchar: char;
  58.       DayLetters: string[14];  {2-chars per day for Sun to Sat}
  59.       WinStyle:byte;
  60.       WX1: byte;          {dimensions of window}
  61.       WY1: byte;
  62.       WX2: byte;
  63.       WY2: byte;
  64.       CX1: byte;          {location of calendar grid within window}
  65.       CY1: byte;
  66.       EMsgFunc: ErrMsgFunc;
  67.       ChooseDay: boolean; {can user scroll a specific day}
  68.       ChosenDate: Dates;
  69.       CalCharHook: KeyPressedHook;
  70.       CalChangeHook: CalChangeProc;
  71.       CalColHook: CalColorProc;
  72.    end; {CalSet}
  73.  
  74. {hooks}
  75. procedure AssignCalCharHook(Hook: KeyPressedHook);
  76. procedure RemoveCalCharHook;
  77. procedure AssignCalChangeHook(Hook: CalChangeProc);
  78. procedure RemoveCalChangeHook;
  79. procedure AssignCalColorHook(Hook: CalColorProc);
  80. procedure RemoveCalColorHook;
  81. procedure CalDefaultSettings;
  82. {main calendar}
  83. function  DrawMonth(Mon,Yr:word;X1,Y1:byte;Active:boolean):Dates;
  84. function  RunCalendar(StartDate:Dates;Tit:string):dates;
  85. {desktop functions}
  86. function  LaunchCalendar(StartDate:Dates;Tit:string): byte;
  87. {error}
  88. function  LastCalError: integer;
  89. {internal}
  90. procedure CalProcessKey;
  91. procedure DrawDay(X1,Y1:byte; Day, AnchorDay:Dates; Col:byte);
  92.  
  93. var
  94.    CalVars: CALSet;
  95.  
  96. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  97.  
  98. {$IFOPT F-}
  99.    {$DEFINE FOFF}
  100.    {$F+}
  101. {$ENDIF}
  102. function CalEMsg(ECode:integer): string;
  103. {}
  104. begin
  105.    case Ecode of
  106.       0: exit;
  107.       1: CalEMsg := 'Not enough memory to draw calendar window';
  108.       else
  109.          CalEMsg := 'Internal calendar error';
  110.    end; {case}
  111. end; { CalEMsg }
  112. {$IFDEF FOFF}
  113.    {$F-}
  114.    {$UNDEF FOFF}
  115. {$ENDIF}
  116.  
  117. procedure CalSetError(ECode:integer);
  118. {}
  119. {$IFOPT D+}
  120. var Msg: StrScreen;
  121. {$ENDIF}
  122. begin
  123.    CalVars.LastEcode := ECode;
  124. {$IFOPT D+}  {if debug active display an error message and terminate}
  125.    if Ecode <> 0 then
  126.    begin
  127.       str(Ecode,Msg);
  128.       Msg := Msg+': '+CalVars.EMsgFunc(Ecode);
  129.       SetWinIgnore(true);
  130.       if PromptCustom(' GoldCal Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
  131.          Halt;
  132.    end;
  133. {$ENDIF}
  134. end; {CalSetError}
  135.  
  136. function LastCalError: integer;
  137. {}
  138. begin
  139.    LastCalError := CalVars.LastECode;
  140. end; { LastCalError }
  141.  
  142.                           {*********************}
  143.                           {**  Hook Routines  **}
  144.                           {*********************}
  145.  
  146. procedure AssignCalCharHook(Hook: KeyPressedHook);
  147. {}
  148. begin
  149.    CalVars.CalCharHook := Hook;
  150. end; { AssignCalCharHook }
  151.  
  152. procedure NoCalCharHook(var Code:word; var X,Y:byte);
  153. begin
  154.    {abstract}
  155. end; { NoCalChangeHook }
  156.  
  157. procedure RemoveCalCharHook;
  158. {}
  159. begin
  160.    CalVars.CalCharHook := NoCalCharHook; {1.01a}
  161. end; { RemoveCalCharHook }
  162.  
  163. procedure AssignCalChangeHook(Hook: CalChangeProc);
  164. {}
  165. begin
  166.    CalVars.CalChangeHook := Hook;
  167. end; { AssignCalChangeHook }
  168.  
  169. procedure NoCalChangeHook(CType:gCalChange;Val1,Val2:dates);
  170. begin
  171.    {abstract}
  172. end; { NoCalChangeHook }
  173.  
  174. procedure RemoveCalChangeHook;
  175. {}
  176. begin
  177.    CalVars.CalChangeHook := NoCalChangeHook; {1.01a}
  178. end; { RemoveCalChangeHook }
  179.  
  180. procedure AssignCalColorHook(Hook: CalColorProc);
  181. {}
  182. begin
  183.    CalVars.CalColHook := Hook;
  184. end; { AssignCalColorHook }
  185.  
  186. procedure NoCalColorHook(DaytoColor:Dates; var DefCol: byte);
  187. begin
  188.    {abstract}
  189. end; { NoCalColorHook }
  190.  
  191. procedure RemoveCalColorHook;
  192. {}
  193. begin
  194.    CalVars.CalColHook := NoCalColorHook; {1.01a}
  195. end; { RemoveCalColorHook }
  196.  
  197.  
  198.                         {*************************}
  199.                         {**  Calendar Routines  **}
  200.                         {*************************}
  201.  
  202. procedure DrawDay(X1,Y1:byte; Day, AnchorDay:Dates; Col:byte);
  203. {}
  204. var
  205.    M,D:word;
  206.    Y: longint;
  207. begin
  208.    JulToGreg(Day,M,D,Y);
  209.    if @CalVars.CalColHook <> nil then
  210.       CalVars.CalColHook(Day,Col);
  211.    WriteAt(X1 + 3 * ( (Day - pred(AnchorDay) - 1) mod 7 ),
  212.            Y1 + (Day - pred(AnchorDay) - 1) div 7,
  213.            Col, PadRight(IntToStr(D),2,' '));
  214. end; { DrawDay }
  215.  
  216. function DrawMonthEngine(Mon,Yr:word;var FofM,LofM,Today:Dates;X1,Y1:byte;Active:boolean):Dates;
  217. {INTERNAL}
  218. const
  219.    Width = 24;
  220.    Depth = 9;
  221. var
  222.    M,D,Y: word;
  223.    MthStr: string[Width];
  224.    I: integer;
  225.    DOW: byte;
  226.    StartDate,
  227.    PDay: Dates;
  228.    Col:byte;
  229.  
  230. begin
  231.    if Active then
  232.       Col := Tint[CalActiveMonth]
  233.    else
  234.       Col := Tint[CalEdgeMonth];
  235.    ClearText(X1,Y1,X1+pred(Width),Y1+depth-2,Col);
  236.    MthStr := Pad(JustCenter,Months[Mon] + ' ' + IntToStr(Yr),Width,' ');
  237.    if Active then
  238.       Col := Tint[CalTitle];
  239.    WriteAt(X1,Y1,Col,MthStr);
  240.    for I := 1 to 7 do
  241.        WriteAt(X1+2+pred(I)*3,succ(Y1),Col,
  242.                copy(CalVars.DayLetters,1+pred(I)*2,2));
  243.    {draw the month/year changing icons}
  244.    if Active then
  245.    begin
  246.       WriteAt(X1+1,Y1,Tint[CalIcons],CalVars.PrevMChar);
  247.       WriteAt(X1+3,Y1,Tint[CalIcons],CalVars.NextMChar);
  248.       WriteAt(X1+20,Y1,Tint[CalIcons],CalVars.PrevYChar);
  249.       WriteAt(X1+22,Y1,Tint[CalIcons],CalVars.NextYChar);
  250.    end;
  251.    {time to determine the Julian date of the first day in the date matrix}
  252.    StartDate := GregToJul(Mon,1,Yr);
  253.    FofM := StartDate;
  254.    if Mon < 12 then
  255.       LofM := pred(GregToJul(succ(Mon),1,Yr))
  256.    else
  257.       LofM := pred(GregToJul(1,1,succ(Yr)));
  258.    DOW := DOWJul(StartDate);
  259.    dec(StartDate,DOW);
  260.    Today := TodayInJul;
  261.    for I := 1 to 42 do
  262.    begin
  263.       PDay := StartDate+pred(I);
  264.       if ((PDay < FofM) or (PDay > LofM)) or (Active = false) then
  265.          Col := Tint[CalEdgeMonth]
  266.       else if PDay = Today then
  267.          Col := Tint[CalToday]
  268.       else
  269.          Col := Tint[CalActiveMonth];
  270.       if ((PDay >= FofM) and (PDay <= LofM)) or (Active = true) then
  271.          DrawDay(X1+2,Y1+2,StartDate+pred(I),StartDate,Col);
  272.    end;
  273.    DrawMonthEngine := StartDate;
  274. end; { DrawMonthEngine }
  275.  
  276. function DrawMonth(Mon,Yr:word;X1,Y1:byte;Active:boolean):Dates;
  277. {Draws the calendar for the specified month and returns
  278.  the Julian date of the first day in the 7*6 day-matrix}
  279. var
  280.    FofM,LofM,Today: Dates;
  281. begin
  282.    DrawMonth := DrawMonthEngine(Mon,Yr,FofM,LofM,Today,X1,Y1,Active);
  283. end; { DrawMonth }
  284.  
  285. function CalPaint(StartDate:Dates;Tit:string;X1,Y1,X2,Y2:byte ):integer;
  286. {}
  287. var
  288.   Handle:integer;
  289.   WinP: WStructurePtr;
  290.  
  291.   procedure SetWindow;
  292.   {}
  293.   begin
  294.      with CalVars do
  295.      begin
  296.         Handle := WinCreate(X1,Y1,X2,Y2,WinStyle);
  297.         WinSetType(Handle,WMove);
  298.         WinSetTitle(Handle,Tit);
  299.         WinSetShowNum(Handle,false);
  300.         WinSetColor(Handle,WinBorder,Tint[CalBorder]);
  301.         WinSetColor(Handle,WinBorderOff,Tint[CalBorderOff]);
  302.         WinSetColor(Handle,WinIcons,Tint[CalIcons]);
  303.         WinSetColor(Handle,WinBody,Tint[CalActiveMonth]);
  304.         WinSetColor(Handle,WinTitle,Tint[CalTitle]);
  305.         WinPaint(Handle);
  306.      end;
  307.   end; { SetWindow }
  308.  
  309. begin
  310.    SetWindow;
  311.    WinDisplay(Handle);
  312.    WinP := WinPtr(Handle);
  313.    if WinP <> nil then
  314.    begin
  315.       getmem(WinP^.UserData,sizeof(CalInfo));
  316.       with CalInfo(WinP^.UserData^) do
  317.       begin
  318.          JulToGreg(StartDate,ActiveMonth,ActiveDay,ActiveYear);
  319.       with CalVars do
  320.          AnchorDay := DrawMonthEngine(ActiveMonth,ActiveYear,FofM,LofM,Today,CX1,CY1,true);
  321.       WinDrawTop;
  322.       {call the ChangeHook to indicate window is drawn}
  323.       if @CalVars.CalChangeHook <> nil then
  324.          CalVars.CalChangeHook(Paint,ActiveMonth,ActiveYear);
  325.       end;
  326.    end;
  327.    CalPaint := handle;
  328. end; { CalPaint }
  329.  
  330. {$IFOPT F-}
  331.    {$DEFINE FOFF}
  332.    {$F+}
  333. {$ENDIF}
  334.  function CalCloseHandler(Handle: integer):boolean;
  335.  {}
  336.  var
  337.     WinP: WStructurePtr;
  338.  begin
  339.     WinP := WinPtr(Handle);
  340.     if WinP <> nil then
  341.        freemem(WinP^.Userdata,sizeof(CalInfo));
  342.     WinDispose(Handle);
  343.     CalCloseHandler := true;
  344.  end; {CalCloseHandler}
  345. {$IFDEF FOFF}
  346.    {$F-}
  347.    {$UNDEF FOFF}
  348. {$ENDIF}
  349.  
  350. procedure CalProcessKey;
  351. {}
  352. var
  353.   WinP: WStructurePtr;
  354.   NewDate: Dates;
  355.   TempDate:dates;
  356.   MX,MY: byte;
  357.   WaitTime: integer;
  358.   Handle: byte;
  359.  
  360.   procedure DelayIt;
  361.   {}
  362.   begin
  363.      delay(WaitTime);
  364.      if WaitTime <> KeyVars.ScrollDelay then
  365.         WaitTime := KeyVars.ScrollDelay;
  366.   end; { DelayIt }
  367.  
  368.   procedure ChangeActiveDay(ClearOldDay:boolean;Newday:dates);
  369.   {}
  370.   begin
  371.      with CalVars do
  372.      with CalInfo(WinP^.UserData^) do
  373.      begin
  374.         if ClearOldDay then
  375.         begin
  376.            if ActiveDate = Today then
  377.               DrawDay(CX1+2,CY1+2,ActiveDate,AnchorDay,Tint[CalToDay])
  378.            else
  379.               DrawDay(CX1+2,CY1+2,ActiveDate,AnchorDay,Tint[CalActiveMonth]);
  380.         end;
  381.         if @CalVars.CalChangeHook <> nil then
  382.            CalVars.CalChangeHook(ChangeDay,Activedate,NewDay);
  383.         ActiveDate := NewDay;
  384.         DrawDay(CX1+2,CY1+2,ActiveDate,AnchorDay,Tint[CalHiDay]);
  385.      end;
  386.   end; { ChangeActiveDay }
  387.  
  388.   procedure NextMonth;
  389.   {}
  390.   begin
  391.      with CalVars do
  392.      with CalInfo(WinP^.UserData^) do
  393.      begin
  394.         if ActiveMonth < 12 then
  395.            inc(ActiveMonth)
  396.         else
  397.         begin
  398.            ActiveMonth := 1;
  399.            inc(ActiveYear);
  400.         end;
  401.         AnchorDay := DrawMonthEngine(ActiveMonth,ActiveYear,FofM,LofM,Today,CX1,CY1,true);
  402.         if @CalChangeHook <> nil then
  403.            CalChangeHook(ChangeMonth,ActiveMonth,ActiveYear);
  404.         if ChooseDay then
  405.            ChangeActiveDay(false,FofM);
  406.      end; {with}
  407.   end; { NextMonth }
  408.  
  409.   procedure PrevMonth;
  410.   {}
  411.   begin
  412.      with CalVars do
  413.      with CalInfo(WinP^.UserData^) do
  414.      begin
  415.         if ActiveMonth > 1 then
  416.            dec(ActiveMonth)
  417.         else if ActiveYear > 0 then
  418.         begin
  419.            ActiveMonth := 12;
  420.            dec(ActiveYear);
  421.         end;
  422.         AnchorDay := DrawMonthEngine(ActiveMonth,ActiveYear,FofM,LofM,Today,CX1,CY1,true);
  423.         if @CalChangeHook <> nil then
  424.            CalChangeHook(ChangeMonth,ActiveMonth,ActiveYear);
  425.         if ChooseDay then
  426.            ChangeActiveDay(false,LofM);
  427.      end;
  428.   end; { PrevMonth }
  429.  
  430.   procedure ChangeYear(NewYear:word);
  431.   {}
  432.   begin
  433.      with CalVars do
  434.      with CalInfo(WinP^.UserData^) do
  435.      begin
  436.         JulToGreg(ActiveDate,ActiveMonth,ActiveDay,ActiveYear);
  437.         if (ActiveMonth = 2) and (ActiveDay = 29) then
  438.            ActiveDay := 28;
  439.         ActiveYear := NewYear;
  440.         ActiveDate := GregToJul(ActiveMonth,ActiveDay,ActiveYear);
  441.         AnchorDay := DrawMonthEngine(ActiveMonth,ActiveYear,FofM,LofM,Today,CX1,CY1,true);
  442.         if @CalChangeHook <> nil then
  443.            CalChangeHook(ChangeMonth,ActiveMonth,ActiveYear);
  444.         if ChooseDay then
  445.            ChangeActiveDay(false,ActiveDate);
  446.      end;
  447.   end; { ChangeYear }
  448.  
  449.   function GetDay(X,Y:byte):Dates;
  450.   {Returns the Jul date clicked on with mouse, or zero if not on active day}
  451.   var NewDate: Dates;
  452.   begin
  453.      GetDay := 0;
  454.      with CalVars do
  455.      with CalInfo(WinP^.UserData^) do
  456.      begin
  457.         if (X>=CX1+2) and (X<=CX1+21) and (Y>=CY1+2) and (Y<=CY1+7)
  458.         and ((X - CX1 - 1) mod 3 <> 0)  then  {not inbetween the columns}
  459.         begin
  460.            NewDate := AnchorDay + (Y-CY1-2)*7 + ((X-CX1-2) div 3);
  461.            if (NewDate >= FofM) and (NewDate <= LofM) then
  462.               GetDay := NewDate;
  463.         end;
  464.      end;
  465.   end; { GetDay }
  466.  
  467.   procedure MouseClick(X,Y:byte);
  468.   {Responds to mouse click on any day in the active month}
  469.   begin
  470.      with CalVars do
  471.      with CalInfo(WinP^.UserData^) do
  472.      begin
  473.         NewDate := GetDay(X,Y);
  474.         if (NewDate <> 0)
  475.         and (NewDate <> ActiveDate) then
  476.         begin
  477.            ChangeActiveDay(true,NewDate);
  478.            MouseRelease;
  479.         end;
  480.      end; {with}
  481.   end; { MouseClick }
  482.  
  483.   procedure CloseWindow(Escaped:boolean);
  484.   {}
  485.   begin
  486.      if Escaped then
  487.         CalVars.ChosenDate := 0
  488.      else
  489.         CalVars.ChosenDate := CalInfo(WinP^.UserData^).ActiveDate;
  490.      freemem(WinP^.Userdata,sizeof(CalInfo));
  491.      WinDispose(Handle);
  492.   end; { CloseWindow }
  493.  
  494.   procedure ProcessMouseDown;
  495.   {}
  496.   var L,C,R:boolean;
  497.   begin
  498.      with CalInfo(WinP^.UserData^) do
  499.      if WinLocalY(Handle,KeyVars.LastY) = CalVars.CY1 then
  500.         with CalVars do
  501.         begin
  502.            MX := WinLocalX(Handle,KeyVars.LastX);
  503.            if (MX = succ(CX1)) then
  504.               repeat
  505.                  if (MX = succ(CX1)) then
  506.                  begin
  507.                     PrevMonth;
  508.                     WinDrawTop;
  509.                  end;
  510.                  DelayIt;
  511.                  MouseStatus(L,C,R,MX,MY);
  512.                  MX := WinLocalX(Handle,KeyVars.LastX);
  513.               until not L;
  514.            if (MX = CX1+3) then
  515.               repeat
  516.                  if (MX = CX1+3) then
  517.                  begin
  518.                     NextMonth;
  519.                     WinDrawTop;
  520.                  end;
  521.                  DelayIt;
  522.                  MouseStatus(L,C,R,MX,MY);
  523.                  MX := WinLocalX(Handle,KeyVars.LastX);
  524.               until not L;
  525.            if (MX = CX1+20) then
  526.               repeat
  527.                  if (MX = CX1+20) then
  528.                  begin
  529.                     ChangeYear(succ(ActiveYear));
  530.                     WinDrawTop;
  531.                  end;
  532.                  DelayIt;
  533.                  MouseStatus(L,C,R,MX,MY);
  534.                  MX := WinLocalX(Handle,KeyVars.LastX);
  535.               until not L;
  536.            if (MX = CX1+22) then
  537.               repeat
  538.                  if (MX = CX1+22) then
  539.                  begin
  540.                     ChangeYear(pred(ActiveYear));
  541.                     WinDrawTop;
  542.                  end;
  543.                  DelayIt;
  544.                  MouseStatus(L,C,R,MX,MY);
  545.                  MX := WinLocalX(Handle,KeyVars.LastX);
  546.               until not L;
  547.         end else
  548.         if CalVars.ChooseDay then
  549.            MouseClick(WinLocalX(Handle,KeyVars.LastX),WinLocalY(Handle,KeyVars.LastY));
  550.   end; { ProcessMouseDown }
  551.  
  552.  
  553. begin
  554.    Handle := WinWithFocus;
  555.    WaitTime := KeyVars.InitScrollDelay;
  556.    WinP := WinPtr(Handle);
  557.    with CalInfo(WinP^.UserData^) do
  558.    begin
  559.       with KeyVars do
  560.       begin
  561.          if @CalVars.CalCharHook <> nil then
  562.             CalVars.CalCharHook(LastKey,LastX,LastY); {call user hook}
  563.          if IsWinKey(LastKey,LastX,LastY) then
  564.             WinProcessKey(LastKey,LastX,LastY);
  565.       end;
  566.       if KeyVars.LastKey = CalVars.NextMKey then
  567.          NextMonth
  568.       else if KeyVars.LastKey = CalVars.PrevMKey then
  569.          PrevMonth
  570.       else if KeyVars.LastKey = CalVars.NextYKey then
  571.          ChangeYear(succ(ActiveYear))
  572.       else if KeyVars.LastKey = CalVars.PrevYKey then
  573.          ChangeYear(pred(ActiveYear))
  574.       else
  575.          case KeyVars.Lastkey of
  576.             328: if CalVars.ChooseDay then {up cursor}
  577.                  begin
  578.                     if ActiveDate-7 < FofM then
  579.                     begin
  580.                        TempDate := ActiveDate + 27;
  581.                        while TempDate > LofM do
  582.                           dec(TempDate,7);
  583.                        ChangeActiveDay(true,Tempdate);
  584.                     end else
  585.                        ChangeActiveDay(true,ActiveDate-7);
  586.                  end;
  587.             336: if CalVars.ChooseDay then {down cursor}
  588.                  begin
  589.                     if ActiveDate+7 > LofM then
  590.                     begin
  591.                        TempDate := ActiveDate - 27;
  592.                        while TempDate < FofM do
  593.                           inc(TempDate,7);
  594.                        ChangeActiveDay(true,TempDate);
  595.                     end else
  596.                        ChangeActiveDay(true,ActiveDate+7);
  597.                  end;
  598.             331: if CalVars.ChooseDay then {left cursor}
  599.                  begin
  600.                     if ActiveDate > FofM then
  601.                        ChangeActiveDay(true,pred(ActiveDate))
  602.                     else
  603.                        ChangeActiveDay(true,LofM);
  604.                  end;
  605.             333: if CalVars.ChooseDay then {right cursor}
  606.                  begin
  607.                     if ActiveDate < LofM then
  608.                        ChangeActiveDay(true,succ(ActiveDate))
  609.                     else
  610.                        ChangeActiveDay(true,FofM);
  611.                  end;
  612.             600: begin {close icon}
  613.                     CloseWindow(true);
  614.                     MouseRelease;
  615.                  end;
  616.             13:  CloseWindow(false);
  617.             27:  CloseWindow(true);
  618.             500: ProcessMouseDown;
  619.             540: begin
  620.                  if CalVars.ChooseDay then
  621.                  begin
  622.                     NewDate := GetDay(WinLocalX(Handle,KeyVars.LastX),WinLocalY(Handle,KeyVars.LastY));
  623.                     if NewDate <> 0 then
  624.                     begin
  625.                        CloseWindow(false);
  626.                        MouseRelease;
  627.                     end else
  628.                     begin
  629.                        KeyVars.LastX := 0; {indicates that session is not finished}
  630.                        ProcessMouseDown;   {treat as single click}
  631.                     end;
  632.                  end;
  633.             end;
  634.          end;
  635.       end;
  636. end; { CalProcessKey }
  637.  
  638. function RunCalendar(StartDate:Dates;Tit:string):dates;
  639. {Modal window which displays a monthly calendar}
  640. var
  641.    WinP: WStructurePtr;
  642.    Handle : integer;
  643.  
  644.    function Finished: boolean;
  645.    {}
  646.    begin
  647.       with KeyVars do
  648.          Finished := (LastKey = 600)
  649.                   or ((LastKey = 540) and (LastX <> 0) and (Calvars.Chooseday))
  650.                   or (LastKey = 27)
  651.                   or (LastKey = 13);
  652.    end; { Finished }
  653.  
  654. begin
  655.    CursorOff;
  656.    with CalVars do
  657.       Handle := CalPaint(StartDate,Tit,WX1,WY1,WX2,WY2);
  658.    if Handle = 0 then
  659.    begin
  660.       CalSetError(1);
  661.       RunCalendar := 0;
  662.    end
  663.    else
  664.    begin
  665.       WinP := WinPtr(Handle);
  666.       with CalVars, CalInfo(WinP^.UserData^) do
  667.       begin
  668.          ActiveDate := StartDate;
  669.          if ChooseDay then
  670.             DrawDay(CX1+2,CY1+2,ActiveDate,AnchorDay,Tint[CalHiDay]);
  671.          if @CalChangeHook <> nil then
  672.             CalChangeHook(ChangeDay,Activedate,ActiveDate);
  673.          WinDrawAll;
  674.          repeat
  675.             GetInput;
  676.             CalProcessKey;
  677.             WinDrawAll;
  678.          until Finished;
  679.          RunCalendar := ChosenDate;
  680.       end;
  681.    end;
  682.    CursorOn;
  683. end; {RunCalendar}
  684.  
  685. {$IFOPT F-}
  686.    {$DEFINE FOFF}
  687.    {$F+}
  688. {$ENDIF}
  689. procedure CalProcessKeyOnDesktop;
  690. {}
  691. begin
  692.    with KeyVars do
  693.       if (Lastkey <> 13)
  694.       and (Lastkey <> 27)
  695.       and (Lastkey <> 540) then
  696.           CalProcessKey;
  697. end; { CalProcessKeyOnDesktop }
  698. {$IFDEF FOFF}
  699.    {$F-}
  700.    {$UNDEF FOFF}
  701. {$ENDIF}
  702.  
  703. function LaunchCalendar(StartDate:Dates;Tit:string): byte;
  704. {Call this proc when adding a calendar to the desktop}
  705. var
  706.    Handle: byte;
  707.    WinP: WStructurePtr;
  708.    X,Y:byte;
  709. begin
  710.    WinFadeTopWin;
  711.    with CalVars do
  712.       if WinVars.DesktopCascadeNew then {get new window position}
  713.       begin
  714.          DeskNextWinCoords(X,Y);
  715.          Handle := CalPaint(StartDate,Tit,X,Y,X+WX2-WX1,Y+WY2-WY1);
  716.       end
  717.       else
  718.          Handle := CalPaint(StartDate,Tit,WX1,WY1,WX2,WY2);
  719.    WinP := WinPtr(Handle);
  720.    with CalVars do
  721.    with CalInfo(WinP^.UserData^) do
  722.    begin
  723.       ActiveDate := StartDate;
  724.       if ChooseDay then
  725.          DrawDay(CX1+2,CY1+2,ActiveDate,AnchorDay,Tint[CalHiDay]);
  726.    end;
  727.    WinP^.ProcessKeyProc := CalProcessKeyOnDeskTop;
  728.    WinP^.CloseWinProc := CalCloseHandler;
  729.    WinDrawTop;
  730.    LaunchCalendar := Handle;
  731. end; { LaunchCalendar }
  732.  
  733.               {*********************************************}
  734.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  735.               {*********************************************}
  736.  
  737. procedure CalDefaultSettings;
  738. {}
  739. begin
  740.    with CalVars do
  741.    begin
  742.       NextMkey := 337; {PgDn}
  743.       PrevMkey := 329; {PgUp}
  744.       NextYkey := 374; {Ctrl-PgDn}
  745.       PrevYkey := 388; {Ctrl-PgUp}
  746.       NextMchar := '';
  747.       PrevMchar := '';
  748.       NextYchar := '';
  749.       PrevYchar := '';
  750.       DayLetters := 'SuMoTuWeThFrSa';
  751.       WinStyle := 1;
  752.       WX1 := 28;
  753.       WY1 := 9;
  754.       WX2 := 53;
  755.       WY2 := 18;
  756.       CX1 := 1;
  757.       CY1 := 1;
  758.       ChooseDay := true;
  759.       CalCharHook := NoKeyPressedHook;
  760.       CalChangeHook := NoCalChangeHook;
  761.       CalColHook := NoCalColorHook;
  762.    end;
  763. end; { CalDefaultSettings }
  764.  
  765. procedure GoldCALInit;
  766. {}
  767. begin
  768.    with CalVars do
  769.    begin
  770.       LastECode := 0;
  771.       EMsgFunc := CalEMsg;
  772.    end;
  773.    CalDefaultSettings;
  774. end; { GoldCALInit }
  775.  
  776. begin
  777.    GoldCALInit;
  778. end.
  779.